home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / POPV.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-08-29  |  34.2 KB  |  935 lines  |  [TEXT/.Ob4]
  1. Syntax10b.Scn.Fnt
  2. Syntax10.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. InfoElems
  5. Alloc
  6. Syntax10.Scn.Fnt
  7. StampElems
  8. Alloc
  9. 29 Aug 95
  10. "Title": POPV
  11. "Author": RC/ mmb
  12. "Abstract": 
  13. "Keywords": 
  14. "Version": 
  15. "From":  RC 6.3.89 / 28.8.91, mmb11.2.93
  16. "Until": 
  17. "Changes": 
  18. mah    14.8.95    Fehler in ActualPar. Dynarr als Stackparameter => Laenge und Adr in selben Register
  19. mah    14.8.95    Fehler in Stringhandling. alignment exception possible weil nicht auf mod 4 ausgerichtet.
  20. MODULE POPV;    (* RC 6.3.89 / 28.8.91, mmb11.2.93 *)
  21.     IMPORT
  22.         OPT := POPT, OPL := POPL, OPC := POPC, OPM := POPM, SYSTEM;
  23.     CONST
  24.         (* item/object modes *)
  25.         Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
  26.         SProc = 8; CProc = 9; Mod = 11; IProc = 10; Head = 12; TProc = 13;
  27.         Based = 14; Indexed = 15; Reg = 16; RegSI = 17; FReg = 18; Cond = 19;
  28.         (* symbol values and ops *)
  29.         times = 1; slash = 2; div = 3; mod = 4;
  30.         and = 5; plus = 6; minus = 7; or = 8; eql = 9;
  31.         neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
  32.         in = 15; is = 16; ash = 17; msk = 18; len = 19;
  33.         conv = 20; abs = 21; cap = 22; odd = 23; not = 33;
  34.         (*SYSTEM*)
  35.         adr = 24; cc = 25; bit = 26; lsh = 27; rot = 28; val = 29;
  36.         (* structure forms *)
  37.         Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  38.         Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  39.         Pointer = 13; ProcTyp = 14; Comp = 15;
  40.         (* structure sets *)
  41.         RealTypes = {Real, LReal};
  42.         (* composite structure forms *)
  43.         Basic = 1; Array = 2; DynArr = 3; Record = 4;
  44.         (* nodes classes *)
  45.         Nvar = 0; Nvarpar = 1; Nfield = 2; Nderef = 3; Nindex = 4; Nguard = 5; Neguard = 6;
  46.         Nconst = 7; Ntype = 8; Nproc = 9; Nupto = 10; Nmop = 11; Ndop = 12; Ncall = 13;
  47.         Ninittd = 14; Nif = 15; Ncaselse = 16; Ncasedo = 17; Nenter = 18; Nassign = 19;
  48.         Nifelse =20; Ncase = 21; Nwhile = 22; Nrepeat = 23; Nloop = 24; Nexit = 25;
  49.         Nreturn = 26; Nwith = 27; Ntrap = 28; Ncommon = 29;
  50.         (*function number*)
  51.         assign = 0; newfn = 1; incfn = 13; decfn = 14;
  52.         inclfn = 15; exclfn = 16; copyfn = 18; assertfn = 32;
  53.         (*SYSTEM function number*)
  54.         getfn = 24; putfn = 25; getrfn = 26; putrfn = 27; sysnewfn = 30; movefn = 31;
  55.         (* module visibility of objects *)
  56.         internal = 0; external = 1; externalR = 2;
  57.         (* procedure flags (conval^.setval) *)
  58.         hasBody = 1; isRedef = 2; slNeeded = 3;
  59.         DoCommonDesign = TRUE;    (* identify same designators not containing expressions: design := design op expr *)
  60.         (* machine specific stuff *)
  61.         (* condition code bits *)
  62.         bLT = 0; bGT = 1; bEQ = 2; bSO = 3;
  63.         (* trap numbers *)
  64.         IndexCheck = 1; DivideTrap = 2; CaseTrap = 3; TypeGuard = 4; FuncTrap = 5;
  65.         memTag = 1024; (* (linkadr > memtag) => parameter passed in memory *) 
  66.         SP = 1; FP = 31;
  67.     TYPE
  68.         Stats* = POINTER TO StatsBlock;            (* debugger info *)
  69.         StatsBlock* = RECORD
  70.             pc-: ARRAY 128 OF SHORTINT;            (* relative pc to last pc. PC's divided by 4 *)
  71.             pos-: ARRAY 128 OF LONGINT;            (* absolute position in source *)
  72.             numStat-: INTEGER;
  73.             next-: Stats;
  74.         END;
  75.         levCall: INTEGER;
  76.         CommonDesign: OPL.Item;
  77.         CommonDesignClass: SHORTINT;
  78.         assert, findpc, powerpc: BOOLEAN;
  79.         stats*, curStats: Stats;                                        (* debugger info *)
  80.         decPC, lastErr, lastClass: LONGINT;
  81.     PROCEDURE FlipBytes (VAR b: ARRAY OF SYSTEM.BYTE);
  82.         VAR i, j: INTEGER; h: SYSTEM.BYTE;
  83.     BEGIN
  84.         IF OPM.CeresVersion THEN
  85.             i := 0; j := SHORT(LEN(b))-1;
  86.             WHILE i < j DO h := b[i]; b[i] := b[j]; b[j] := h; INC(i); DEC(j) END
  87.         END
  88.     END FlipBytes;
  89.     PROCEDURE Align (VAR offset: LONGINT; base: INTEGER);
  90.     BEGIN
  91.         CASE base OF
  92.           1: (* ok *)
  93.         | 2: INC(offset, offset MOD 2)
  94.         | 4: INC(offset, (-offset) MOD 4)
  95.         | 8: INC(offset, (-offset) MOD 8)
  96.         END
  97.     END Align;
  98.     PROCEDURE ^ParamAdr (firstPar: OPT.Object; VAR parSize, varSize: LONGINT; VAR parRegs: SET);
  99.     PROCEDURE Base (typ: OPT.Struct): INTEGER;    (* typ^.comp # DynArr *)
  100.     VAR array: BOOLEAN;        (* mah *)
  101.     BEGIN
  102.         array := typ.comp = Array;        (* mah *)
  103.         WHILE typ^.comp = Array DO typ := typ^.BaseTyp END ;
  104.         IF typ^.comp = Record THEN RETURN ABS(typ^.sysflag)    (*!!!*)
  105.         ELSIF typ^.form = ProcTyp THEN RETURN 4
  106.         ELSIF array & (typ.form = Char) THEN RETURN 4        (* mah *)
  107.         ELSE RETURN SHORT(typ^.size)
  108.         END
  109.     END Base;
  110.     PROCEDURE^ Traverse (obj: OPT.Object; exported: BOOLEAN);
  111.     PROCEDURE ^VisitTProcs (obj: OPT.Object);
  112.     PROCEDURE TypSize* (typ: OPT.Struct; allocDesc: BOOLEAN);
  113.         VAR
  114.             f, c, base, fbase: INTEGER;
  115.             offset, size, n, dims: LONGINT;
  116.             dval: SET;
  117.             fld: OPT.Object;
  118.             btyp: OPT.Struct;
  119.             sizeUndef, doAlloc: BOOLEAN;
  120.     BEGIN
  121.         IF typ = OPT.undftyp THEN OPM.err(58)
  122.         ELSE
  123.             sizeUndef := typ^.size = -1;
  124.             doAlloc := allocDesc & (typ^.tdadr = OPM.TDAdrUndef) & (typ^.offset = OPM.TDAdrUndef);
  125.             IF sizeUndef OR doAlloc THEN
  126.                 IF doAlloc THEN typ^.tdadr := -2 (* avoid cycles *) END ;
  127.                 f := typ^.form; c := typ^.comp; btyp := typ^.BaseTyp;
  128.                 IF c = Record THEN
  129.                     IF typ^.sysflag = 1 THEN typ^.sysflag := -2 END;    (*!!!*)
  130.                     IF btyp = NIL THEN offset := 0; base := 1
  131.                     ELSE TypSize(btyp, allocDesc); offset := btyp^.size; base := btyp^.sysflag
  132.                     END;
  133.                     IF btyp = NIL THEN typ^.n := 0 ELSE typ^.n := btyp^.n END ;
  134.                     VisitTProcs(typ^.link);
  135.                     fld := typ^.link;
  136.                     WHILE (fld # NIL) & (fld^.mode = Fld) DO
  137.                         btyp := fld^.typ; TypSize(btyp, allocDesc);
  138.                         IF sizeUndef THEN size := btyp^.size;
  139.                             fbase := Base(btyp);
  140.                             IF (typ^.sysflag < 0) & (fbase > 2) THEN Align(offset, 2) ELSE Align(offset, fbase) END;    (*!!!*)
  141.                             fld^.adr := offset; INC(offset, size);
  142.                             IF fbase > base THEN base := fbase END
  143.                         END ;
  144.                         fld := fld^.link
  145.                     END ;
  146.                     IF sizeUndef THEN
  147.                         IF typ^.sysflag >= 0 THEN Align(offset, base); typ^.sysflag := base END;    (*!!!*)
  148.                         typ^.size := offset
  149.                     END ;
  150.                     IF doAlloc THEN OPL.AllocTypDesc(typ); Traverse(typ^.link, TRUE) END
  151.                 ELSIF c = Array THEN
  152.                     TypSize(btyp, allocDesc);
  153.                     IF (btyp^.sysflag < 0) & (btyp^.size MOD 4 # 0) THEN OPM.err(252) END;    (*!!!*)
  154.                     IF sizeUndef THEN typ^.size := typ^.n * btyp^.size END
  155.                 ELSIF f = Pointer THEN
  156.                     typ^.size := OPM.PointerSize;
  157.                     IF doAlloc THEN TypSize(btyp, allocDesc) END
  158.                 ELSIF f = ProcTyp THEN
  159.                     typ^.size := OPM.ProcSize;
  160.                     IF doAlloc THEN TypSize(btyp, TRUE); ParamAdr(typ^.link, offset, size, dval) END
  161.                         (* offset, size and dval are dummies *)
  162.                 ELSE (* (c = DynArr) & doAlloc *)
  163.                     n := typ^.n; dims := n + 1; btyp := typ;
  164.                     WHILE n >= 0 DO
  165.                         btyp^.offset := 4*(dims-n); btyp^.size := 4*n + 8;
  166.                         btyp := btyp^.BaseTyp; DEC(n)
  167.                     END;
  168.                     TypSize(btyp, allocDesc)
  169.                 END
  170.             END
  171.         END
  172.     END TypSize;
  173.     PROCEDURE ParamAdr (firstPar: OPT.Object; VAR parSize, varSize: LONGINT; VAR parRegs: SET);
  174.         VAR
  175.             par: OPT.Object; typ: OPT.Struct;
  176.             padr, vadr: LONGINT; f, c: INTEGER; pused: SET;
  177.         PROCEDURE Alloc (ps, vs: LONGINT);
  178.         BEGIN
  179.             IF (par^.mode # VarPar) & (typ^.form IN {Real, LReal}) & (f <= 13) THEN
  180.                 par^.adr := -1-(FReg*32+f); INCL(pused, f+16); INC(f)
  181.             ELSIF (padr + ps <= 11*4) THEN
  182.                 par^.adr := -1-(Reg*32+padr DIV 4); pused := pused + {(padr+4) DIV 4 .. (padr+ps) DIV 4}
  183.             ELSE par^.adr := padr+12
  184.             END;
  185.             IF vs = 0 THEN par^.linkadr := memTag+padr-12
  186.             ELSE Align(vadr, Base(typ)); par^.linkadr := vadr; INC(vadr, vs)
  187.             END;
  188.             INC(padr, ps)
  189.         END Alloc;
  190.     BEGIN
  191.         padr := 3*4; vadr := 0; par := firstPar; f := 1; pused := parRegs;
  192.         WHILE par # NIL DO
  193.             typ := par^.typ; c := typ^.comp; TypSize(typ, TRUE);
  194.             IF c = DynArr THEN Alloc(typ^.size, 0)
  195.             ELSIF par^.mode = VarPar THEN
  196.                 IF c = Record THEN Alloc(8, 0)
  197.                 ELSE Alloc(4, 0)
  198.                 END
  199.             ELSE
  200.                 IF c IN {Record, Array} THEN Alloc(4, typ^.size)
  201.                 ELSIF typ^.form IN {LReal, ProcTyp} THEN Alloc(8, 0)
  202.                 ELSE Alloc(4, 0)
  203.                 END
  204.             END;
  205.             par := par^.link
  206.         END;
  207.         DEC(padr, 3*4); Align(padr, 8); Align(vadr, 8); parSize := padr*10000H; varSize := vadr; parRegs := pused
  208.     END ParamAdr;
  209.     PROCEDURE VarAdr (var: OPT.Object; VAR varSize: LONGINT);
  210.         VAR adr: LONGINT; typ: OPT.Struct;
  211.     BEGIN adr := varSize;
  212.         WHILE var # NIL DO
  213.             typ := var^.typ; TypSize(typ, TRUE);
  214.             Align(adr, Base(typ)); var^.adr := adr; var^.linkadr := adr; INC(adr, typ^.size);
  215.             var := var^.link
  216.         END;
  217.         Align(adr, 8); varSize := adr
  218.     END VarAdr;
  219.     PROCEDURE ProcSize (obj: OPT.Object; firstpass: BOOLEAN);
  220.         VAR oldPos: LONGINT;
  221.     BEGIN
  222.         oldPos := OPM.errpos; OPM.errpos := obj^.scope^.adr;
  223.         TypSize(obj^.typ, TRUE);
  224.         IF ((obj^.vis # internal) = firstpass) OR (obj^.mode = TProc) THEN
  225.             IF obj^.mode IN {XProc, IProc, TProc} THEN
  226.                 IF OPL.entno < OPL.MaxEntry THEN INC(obj^.adr, LONG(OPL.entno)); INC(OPL.entno)
  227.                 ELSE OPM.err(226); obj^.adr := 1
  228.                 END
  229.             ELSE obj^.adr := -1 (* entry address undef *)
  230.             END;
  231.             TypSize(obj^.typ, TRUE);
  232.             ParamAdr(obj^.link, obj^.conval^.intval, obj^.conval^.intval2, obj^.conval^.setval);
  233.             obj^.linkadr := OPM.LANotAlloc;
  234.         END ;
  235.         IF ~firstpass OR (obj^.mode = TProc) THEN
  236.             IF ~(hasBody IN obj^.conval^.setval) THEN (* forward *) OPM.err(129) END;
  237.             VarAdr(obj^.scope^.scope, obj^.conval^.intval2);    (* local variables *)
  238.             Traverse(obj^.scope^.right, FALSE)
  239.         END;
  240.         OPM.errpos := oldPos
  241.     END ProcSize;
  242.     PROCEDURE VisitTProcs (obj: OPT.Object);    (* TProcs of base type already visited *)
  243.         VAR typ: OPT.Struct; redef: OPT.Object; mthno: LONGINT;
  244.     BEGIN
  245.         IF obj # NIL THEN
  246.             VisitTProcs(obj^.left);
  247.             IF obj^.mode = TProc THEN
  248.                 typ := obj^.link^.typ;
  249.                 IF typ^.form = Pointer THEN typ := typ^.BaseTyp END ;
  250.                 OPT.FindField(obj^.name, typ^.BaseTyp, redef);
  251.                 IF redef # NIL THEN mthno := redef^.adr DIV 10000H;
  252.                     IF ~(isRedef IN obj^.conval^.setval) THEN OPM.err(119) END
  253.                 ELSE mthno := typ^.n; INC(typ^.n)
  254.                 END;
  255.                 obj^.adr := (obj^.adr MOD 10000H) (*entno*) + mthno * 10000H
  256.             END ;
  257.             VisitTProcs(obj^.right)
  258.         END
  259.     END VisitTProcs;
  260.     PROCEDURE Traverse (obj: OPT.Object; exported: BOOLEAN);
  261.     BEGIN
  262.         IF obj # NIL THEN
  263.             Traverse(obj^.left, exported);
  264.             IF (obj^.mode = Typ) & ((obj^.vis # internal) = exported) THEN TypSize(obj^.typ, TRUE)
  265.             ELSIF obj^.mode IN {LProc, XProc, TProc, CProc, IProc} THEN ProcSize(obj, exported)
  266.             END ;
  267.             Traverse(obj^.right, exported);
  268.         END
  269.     END Traverse;
  270.     PROCEDURE AdrAndSize* (topScope: OPT.Object);
  271.         VAR gvarSize: LONGINT;
  272.     BEGIN
  273.         OPM.errpos := topScope^.adr;    (* text position of scope used if error *)
  274.         Traverse(topScope^.right, TRUE);    (* first pass only on exported types and procedures *)
  275.         gvarSize := (* OPT.nofGmod*4+4; *) 0;
  276.         VarAdr(topScope^.scope, gvarSize);    (* global variables *)
  277.         OPL.dsize := gvarSize;
  278.         Traverse(topScope^.right, FALSE);    (* second pass on non-exported types and procedures *)
  279.         OPL.AllocLinkTable(OPT.nofGmod+1)
  280.     END AdrAndSize;
  281.     PROCEDURE SameDesign (n1, n2: OPT.Node): BOOLEAN;
  282.     BEGIN
  283.         LOOP
  284.             IF (n1^.class # n2^.class) OR (n1^.typ # n2^.typ) THEN RETURN FALSE END ;
  285.             CASE n1^.class OF
  286.               Nvar, Nvarpar, Nproc: RETURN n1^.obj = n2^.obj
  287.             | Nfield:
  288.                     IF n1^.obj # n2^.obj THEN RETURN FALSE END
  289.             | Nderef, Nguard:
  290.             | Nindex:
  291.                     IF ~SameDesign(n1^.right, n2^.right) THEN RETURN FALSE END
  292.             ELSE RETURN FALSE
  293.             END ;
  294.             n1 := n1^.left; n2 := n2^.left
  295.         END
  296.     END SameDesign;
  297.     PROCEDURE^ expr (n: OPT.Node; VAR x: OPL.Item; rt: LONGINT);
  298.     PROCEDURE design (n: OPT.Node; VAR x: OPL.Item; rt: LONGINT);
  299.         VAR
  300.             obj: OPT.Object; y: OPL.Item;
  301.             t: LONGINT; class, mode: INTEGER;
  302.             VarRec: BOOLEAN;
  303.     BEGIN
  304.         class := n^.class; x.typ := n^.typ;
  305.         CASE class OF
  306.             Nvar, Nvarpar:
  307.                 obj := n^.obj; x.mnolev := obj^.mnolev; t := obj^.linkadr;
  308.                 IF x.mnolev < 0 THEN t := obj^.adr END;
  309.                 IF t < -1 THEN
  310.                     t := -1-t; mode := SHORT(t DIV 32); x.reg := t MOD 32;
  311.                     IF (mode = Reg) & (class = Nvarpar) & (n^.typ^.comp # DynArr) THEN
  312.                         x.mode := Based; x.offset := 0
  313.                     ELSE x.mode := SHORT(mode)
  314.                     END
  315.                 ELSE x.offset := t; x.adr := obj^.adr; mode := obj^.mode; x.mode := SHORT(mode); x.reg := 0
  316.                 END;
  317.                 x.dmode := SHORT(mode); x.dreg := -1
  318.         |  Nfield:
  319.                 t := rt;
  320.                 IF (n.typ^.form IN {Real, LReal}) OR (n.typ^.form = ProcTyp) & (rt > 12) THEN t := -1 END;
  321.                 (* very temporary patch to make proc calls as well as assignments work right *)
  322.                 design(n^.left, x, t); OPC.Field(x, n^.obj^.adr, -1)
  323.         |  Nderef:
  324.                 design(n^.left, x, rt); OPC.Deref(x, rt);
  325.                 IF n^.typ^.comp = DynArr THEN x.dmode := Based END
  326.         |  Nindex:
  327.                 design(n^.left, x, -1); expr(n^.right, y, -1); OPC.Index(x, y, -1)
  328.         |  Nguard:
  329.                 VarRec := (n^.left^.class = Nvarpar) & (n^.left^.typ^.comp = Record);
  330.                 design(n^.left, x, rt); OPC.TypTest(x, n^.typ, TRUE, FALSE, VarRec)
  331.         |  Neguard:
  332.                 VarRec := (n^.left^.class = Nvarpar) & (n^.left^.typ^.comp = Record);
  333.                 design(n^.left, x, rt); OPC.TypTest(x, n^.typ, TRUE, TRUE, VarRec)
  334.         | Nproc:
  335.                 obj := n^.obj; x.mnolev := obj^.mnolev; x.mode := obj^.mode; x.offset := obj^.adr; x.adr := obj^.linkadr;
  336.                 x.reg := 0;
  337.                 IF x.mode = TProc THEN x.offset := (*mthno*) obj^.adr DIV 10000H; x.dmode := n^.subcl END
  338.         | Ncommon:
  339.                 x := CommonDesign
  340.         END;
  341.         x.typ := n^.typ;
  342.         IF (n^.typ^.comp = DynArr) & (x.dreg = -1) THEN OPC.DynArrItem(x, rt) END
  343.     END design;
  344.     PROCEDURE^ Call (n: OPT.Node; VAR res: OPL.Item; rt: LONGINT);
  345.     PROCEDURE expr (n: OPT.Node; VAR x: OPL.Item; rt: LONGINT);
  346.         VAR
  347.             y, z: OPL.Item;
  348.             f, subcl: SHORTINT;
  349.             t: LONGINT;
  350.             cval: OPT.Const;
  351.             real: REAL;
  352.             l: OPL.Label;
  353.     BEGIN
  354.         x.dreg := -1; y.dreg := -1; z.dreg := -1;
  355.         CASE n^.class OF
  356.             Nconst:
  357.                 x.typ := n^.typ; f := x.typ^.form; cval := n^.conval;
  358.                 CASE f OF
  359.                     Byte, Bool, Char, SInt, Int, LInt, NilTyp, Pointer:
  360.                         x.mode := Con; x.offset := cval^.intval
  361.                 |  Set:
  362.                         x.mode := Con; x.offset := OPM.FlipBits(SYSTEM.VAL(LONGINT, cval^.setval))
  363.                 |  String, Real, LReal:
  364.                         IF (n^.obj = NIL) OR (n^.obj^.conval^.intval = OPM.ConstNotAlloc) THEN
  365.                             IF f = String THEN OPL.AllocConst(cval^.ext^, cval^.intval2, x.offset, 4)
  366.                             ELSIF f = Real THEN real := SHORT(cval^.realval); FlipBytes(real); OPL.AllocConst(real, 4, x.offset, 4)
  367.                             ELSE (* LReal *) FlipBytes(cval^.realval); OPL.AllocConst(cval^.realval, 8, x.offset, 4)
  368.                             END;
  369.                             IF n^.obj # NIL THEN n^.obj^.conval^.intval := x.offset END
  370.                         ELSE x.offset := n^.obj^.conval^.intval
  371.                         END;
  372.                         x.mode := Var; x.mnolev := 0; x.adr := cval^.intval2
  373.                 END
  374.         |  Nupto:
  375.                 expr(n^.left, x, -1); expr(n^.right, y, -1); OPC.SetRange(x, y, rt)
  376.         |  Nmop: subcl := n^.subcl;
  377.                 IF subcl = not THEN l := x.Tjmp; x.Tjmp := x.Fjmp; x.Fjmp := l END;
  378.                 IF subcl IN {adr, val} THEN t := rt ELSE t := -1 END;
  379.                 expr(n^.left, x, t);
  380.                 CASE subcl OF
  381.                     not:
  382.                         OPC.Not(x, rt)
  383.                 |  minus:
  384.                         OPC.Neg(x, rt)
  385.                 |  is:
  386.                         y := x;
  387.                         OPC.TypTest(x, n^.obj^.typ, FALSE, FALSE, (n^.left^.class = Nvarpar) & (n^.left^.typ^.comp = Record))
  388.                 |  conv:
  389.                         IF n^.typ^.form = Set THEN OPC.SetElem(x, rt)
  390.                         ELSE OPC.Convert(x, n^.typ, rt, TRUE)
  391.                         END
  392.                 |  abs:
  393.                         OPC.Abs(x, rt)
  394.                 |  cap:
  395.                         OPC.Cap(x, rt)
  396.                 |  odd:
  397.                         OPC.Odd(x)
  398.                 |  adr:
  399.                         OPC.SYSaddr(x, rt)
  400.                 |  cc:
  401.                         OPM.err(300);
  402.                 |  val:
  403.                         OPC.SYSval(x, x.typ^.form, n^.typ^.form)
  404.                 END
  405.         |  Ndop: subcl := n^.subcl;
  406.                 IF subcl = and THEN
  407.                     y.Fjmp := x.Fjmp; y.Tjmp := 0;
  408.                     expr(n^.left, y, -1);
  409.                     OPC.PutCondBranch(y, FALSE); OPC.SetLabel(y.Tjmp);
  410.                     x.Fjmp := y.Fjmp; expr(n^.right, x, -1)
  411.                 ELSIF subcl = or THEN
  412.                     y.Tjmp := x.Tjmp; y.Fjmp := 0; expr(n^.left, y, -1);
  413.                     OPC.PutCondBranch(y, TRUE); OPC.SetLabel(y.Fjmp);
  414.                     x.Tjmp := y.Tjmp; expr(n^.right, x, -1)
  415.                 ELSIF subcl = plus THEN
  416.                     IF n^.typ^.form IN RealTypes THEN
  417.                         IF n^.left^.subcl = times THEN
  418.                             expr(n^.left^.left, x, -1); expr(n^.left^.right, y, -1); expr(n^.right, z, -1); OPC.MulAdd(x, y, z, rt)
  419.                         ELSIF n^.right^.subcl = times THEN
  420.                             expr(n^.right^.left, x, -1); expr(n^.right^.right, y, -1); expr(n^.left, z, -1); OPC.MulAdd(x, y, z, rt)
  421.                         ELSE
  422.                             expr(n^.left, x, -1); expr(n^.right, y, -1); OPC.Plus(x, y, rt)
  423.                         END
  424.                     ELSE
  425.                         expr(n^.left, x, -1); expr(n^.right, y, -1); OPC.Plus(x, y, rt)
  426.                     END
  427.                 ELSIF subcl = minus THEN
  428.                     IF n^.typ^.form IN RealTypes THEN
  429.                         IF n^.left^.subcl = times THEN
  430.                             expr(n^.left^.left, x, -1); expr(n^.left^.right, y, -1); expr(n^.right, z, -1); OPC.MulSub(x, y, z, rt, FALSE)
  431.                         ELSIF n^.right^.subcl = times THEN
  432.                             expr(n^.right^.left, x, -1); expr(n^.right^.right, y, -1); expr(n^.left, z, -1); OPC.MulSub(x, y, z, rt, TRUE)
  433.                         ELSE
  434.                             expr(n^.left, x, -1); expr(n^.right, y, -1); OPC.Minus(x, y, rt)
  435.                         END
  436.                     ELSE
  437.                         expr(n^.left, x, -1); expr(n^.right, y, -1); OPC.Minus(x, y, rt)
  438.                     END
  439.                 ELSE
  440.                     expr(n^.left, x, -1); expr(n^.right, y, -1);
  441.                     CASE subcl OF
  442.                         times:
  443.                             OPC.Times(x, y, rt)
  444.                     |  div:
  445.                             OPC.Div(x, y, rt)
  446.                     |  slash:
  447.                             OPC.Slash(x, y, rt)
  448.                     |  mod:
  449.                             OPC.Mod(x, y, rt)
  450.                     |  in:
  451.                             OPC.In(x, y)
  452.                     |  ash:
  453.                             OPC.Ash(x, y, rt)
  454.                     |  lsh:
  455.                             OPC.SYSlsh(x, y, rt)
  456.                     |  rot:
  457.                             OPC.SYSrot(x, y, rt)
  458.                     |  msk:
  459.                             OPC.Msk(x, y, rt)
  460.                     |  eql, neq, gtr, geq, lss, leq:
  461.                             OPC.Compare(x, y, subcl)
  462.                     |  len:
  463.                             OPC.Len(x, y, rt)
  464.                     |  bit:
  465.                             OPC.SYSbit(x, y)
  466.                     END
  467.                 END
  468.         |  Ncall:
  469.                 Call(n, x, rt)
  470.         ELSE design(n, x, rt)
  471.         END;
  472.         IF ~powerpc & (n^.typ.form = Real) & (n^.class = Ndop) THEN    (* binary real ops yield a LReal result on POWER *)
  473.             x.typ := OPT.lrltyp
  474.         ELSE x.typ := n^.typ
  475.         END
  476.     END expr;
  477.     PROCEDURE Checkpc;
  478.     BEGIN
  479.         IF findpc & (OPL.pc*4 > OPM.breakpc) & OPM.noerr THEN OPM.err(255) END
  480.         (* in the case of a call, the breakpc value shown in the trap viewer must point to the call instruction
  481.             and not to the next instruction, i.e. breakpc # return address !! *)
  482.     END Checkpc;
  483.     PROCEDURE^ stat (n: OPT.Node);
  484.     PROCEDURE IfStat (n: OPT.Node; withTrap: BOOLEAN);
  485.         VAR ifn: OPT.Node; endlab: OPL.Label; x: OPL.Item;
  486.     BEGIN
  487.         endlab := 0; ifn := n^.left;
  488.         IF withTrap & (ifn^.link = NIL) & (ifn^.left^.class = Nmop) & (ifn^.left^.subcl = is) THEN (* simple with statement *)
  489.             ifn^.left^.class := Nguard; ifn^.left^.typ := ifn^.left^.obj^.typ; 
  490.             OPM.errpos := ifn^.conval^.intval; expr(ifn^.left, x, -1); Checkpc; OPC.With(x); stat(ifn^.right)
  491.         ELSE
  492.             LOOP
  493.                 x.Tjmp := 0; x.Fjmp := 0;
  494.                 OPM.errpos := ifn^.conval^.intval; expr(ifn^.left, x, -1); OPC.PutCondBranch(x, FALSE);
  495.                 OPC.SetLabel(x.Tjmp); Checkpc; stat(ifn^.right); ifn := ifn^.link;
  496.                 IF ifn = NIL THEN EXIT ELSE OPC.PutBranch(endlab); OPC.SetLabel(x.Fjmp) END
  497.             END;
  498.             IF withTrap OR (n^.right # NIL) THEN OPC.PutBranch(endlab); OPC.SetLabel(x.Fjmp);
  499.                 IF withTrap THEN OPC.Trap(TypeGuard); OPM.errpos := n^.conval^.intval; Checkpc ELSE stat(n^.right) END
  500.             ELSE OPC.SetLabel(x.Fjmp)
  501.             END;
  502.             OPC.SetLabel(endlab)
  503.         END
  504.     END IfStat;
  505.     PROCEDURE CaseStat (n: OPT.Node);
  506.         VAR p, range: OPT.Node; x: OPL.Item; endlab: OPL.Label; table, base: LONGINT;
  507.     BEGIN
  508.         expr(n^.left, x, -1); p := n^.right; OPC.Case(x, p^.conval^.intval, p^.conval^.intval2, table); Checkpc;
  509.         base := p^.conval^.intval; endlab := 0;
  510.         IF p^.conval^.setval = {} THEN OPC.Trap(CaseTrap)
  511.         ELSE stat(p^.right); OPC.PutBranch(endlab)
  512.         END;
  513.         p := p^.left;
  514.         WHILE p # NIL DO
  515.             range := p^.left;
  516.             REPEAT
  517.                 OPL.FixCase(range^.conval^.intval-base, range^.conval^.intval2-base, table); range := range^.link
  518.             UNTIL range = NIL;
  519.             stat(p^.right);
  520.             IF p^.link # NIL THEN OPC.PutBranch(endlab) END;
  521.             p := p^.link
  522.         END;
  523.         OPC.SetLabel(endlab)
  524.     END CaseStat;
  525.     PROCEDURE Enter (n: OPT.Node);
  526.         VAR
  527.             p, v: OPT.Object;
  528.             ralloc, falloc, calloc, fsize, adr: LONGINT;
  529.         PROCEDURE Relocate (p: OPT.Object);
  530.             VAR typ: OPT.Struct; form, comp, nrReg: LONGINT;
  531.         BEGIN
  532.             typ := p^.typ; form := typ^.form;
  533.             IF p^.mode = VarPar THEN
  534.                 IF form = Comp THEN comp := typ^.comp;
  535.                     IF comp = DynArr THEN nrReg := typ^.n+2 ELSIF comp = Record THEN nrReg := 2 ELSE nrReg := 1 END
  536.                 ELSE nrReg := 1
  537.                 END;
  538.                 IF ralloc-nrReg > 11 THEN DEC(ralloc, nrReg); p^.linkadr := -1-(ralloc+1+Reg*32) END
  539.             ELSE
  540.                 CASE form OF
  541.                     Byte, Char, SInt, Int, LInt, Set, Pointer:
  542.                         IF ralloc > 12 THEN p^.linkadr := -1-(ralloc+Reg*32); DEC(ralloc) END
  543.                 |  Real, LReal:
  544.                         IF falloc > 13 THEN p^.linkadr := -1-(falloc+FReg*32); DEC(falloc) END
  545.                 |  Bool:
  546.                         IF calloc > 7 THEN p^.linkadr := -1-(calloc+Cond*32); DEC(calloc) END
  547.                 |  Comp:
  548.                         IF typ^.comp = DynArr THEN nrReg := typ^.n+2;
  549.                             IF ralloc-nrReg > 11 THEN DEC(ralloc, nrReg); p^.linkadr := -1-(ralloc+1+Reg*32) END
  550.                         END
  551.                 |  ProcTyp:
  552.                         IF ralloc > 13 THEN DEC(ralloc, 2); p^.linkadr := -1-(ralloc+1+Reg*32) END
  553.                 ELSE
  554.                 END
  555.             END
  556.         END Relocate;
  557.     BEGIN
  558.         p := n^.obj;
  559.         IF p # NIL THEN
  560.             ralloc := 30; falloc := 31; calloc := 19; v := p^.link;
  561.             WHILE v # NIL DO
  562.                 IF (v^.adr < 0) & v^.leaf THEN Relocate(v) END;
  563.                 v := v^.link
  564.             END;
  565.             v := p^.scope^.scope;
  566.             WHILE v # NIL DO
  567.                 IF v^.leaf THEN Relocate(v) END;
  568.                  v := v^.link
  569.             END;
  570.             fsize := p^.conval^.intval2+(31-ralloc)*4+(31-falloc)*8+6*4; Align(fsize, 8);
  571.             v := p^.link;
  572.             WHILE v # NIL DO
  573.                 adr := v^.linkadr;
  574.                 IF (adr >= 0) & ((v^.mode = VarPar) OR (v^.typ^.form # Comp) OR (v^.typ^.comp = DynArr)) THEN
  575.                     v^.linkadr := adr-memTag+fsize
  576.                 END;
  577.                 v := v^.link
  578.             END;
  579.             INC(OPL.level);
  580.             p^.conval^.intval := p^.conval^.intval+ralloc*1024+falloc*32+calloc;
  581.             p^.conval^.intval2 := fsize-6*4
  582.         END
  583.     END Enter;
  584.     PROCEDURE ActualPar (formal: OPT.Object; actual: OPT.Node);
  585.         VAR
  586.             dest, form, mode, rt, n: LONGINT;
  587.             x, y, z, desc, tag: OPL.Item;
  588.             typ, atyp: OPT.Struct;
  589.             ParReg, ind: BOOLEAN;
  590.     BEGIN
  591.         WHILE formal # NIL DO
  592.             dest := formal^.adr; typ := formal^.typ; form := typ^.form; atyp := actual^.typ;
  593.             IF dest < 0 THEN rt := -1-dest; mode := rt DIV 32; rt := rt MOD 32; n := rt;
  594.                 IF ((typ^.form IN RealTypes) & (formal^.mode # VarPar)) # (atyp^.form IN RealTypes) THEN n := -1 END
  595.             ELSE rt := -1; n := rt; mode := Based
  596.             END;
  597.             x.Tjmp := 0; x.Fjmp := 0;
  598.             IF (atyp.comp = DynArr) & (rt > 0) THEN OPL.LockParR (rt + 1) END;        (* mah error dynarr parameter on stack *)
  599.             expr(actual, x, n);
  600.             desc := x; x.dreg := -1; z := x;
  601.             ind := (formal^.mode = VarPar) OR (form IN {String, Comp});
  602.             IF ind THEN 
  603.                 IF atyp^.comp # DynArr THEN OPC.LoadAddr(x, rt) ELSE tag := x END
  604.             END;
  605.             IF (formal^.mode = VarPar) & (typ = OPT.sysptrtyp) & (atyp # OPT.sysptrtyp) THEN
  606.                 tag.mode := Var; tag.typ := OPT.linttyp; tag.mnolev := -atyp^.BaseTyp^.mno;
  607.                 tag.offset := atyp^.BaseTyp^.tdadr;
  608.                 y.mode := Based; y.reg := x.reg; y.offset := 0; y.typ := OPT.linttyp; OPL.HoldTempR(x.reg); OPC.Assign(y, tag);
  609.                 OPL.UnholdTempR(x.reg)
  610.             END;
  611.             y := x;
  612.             IF ~ind THEN y.typ := typ END;
  613.             ParReg := dest < 0;
  614.             IF ParReg THEN y.mode := SHORT(SHORT(mode)); y.reg := rt
  615.             ELSE y.mode := Based; y.reg := SP; y.offset := dest
  616.             END;
  617.             IF atyp^.comp # DynArr THEN OPC.Assign(y, x) END;
  618.             IF mode = Reg THEN
  619.                 OPL.LockParR(rt);
  620.                 IF form = ProcTyp THEN OPL.LockParR(rt+1) END
  621.             ELSIF mode = FReg THEN
  622.                 OPL.LockParF(rt)
  623.             END;
  624.             IF (formal^.mode = VarPar) & (form = Comp) & (typ^.comp = Record) THEN
  625.                 IF actual^.class = Nderef THEN
  626.                     ASSERT(x.mode = Reg);
  627.                     x.mode := Based; x.offset := -4
  628.                 ELSIF actual^.class = Nvarpar THEN
  629.                     x := z; ASSERT(x.mode IN {Based, VarPar});
  630.                     IF x.mode = Based THEN x.mode := Reg; INC(x.reg) ELSE x.mode := Var; INC(x.offset, 4) END
  631.                 ELSE
  632.                     x.mode := Var; typ := actual^.typ; x.mnolev := -typ^.mno; x.offset := typ^.tdadr
  633.                 END;
  634.                 x.typ := OPT.linttyp; ASSERT(y.mode IN {Reg, Based});
  635.                 IF ParReg THEN INC(y.reg) ELSE INC(y.offset, 4) END;
  636.                 OPC.Assign(y, x);
  637.                 IF ParReg THEN OPL.LockParR(y.reg) END
  638.             ELSIF (form = Comp) & (typ^.comp = DynArr) THEN
  639.                 IF atyp^.comp # DynArr THEN
  640.                     n := typ^.n; typ := typ^.BaseTyp;
  641.                     WHILE n >= 0 DO
  642.                         x.mode := Con; x.typ := OPT.linttyp;
  643.                         IF atyp^.form = String THEN x.offset := x.adr
  644.                         ELSIF typ^.form = Byte THEN x.offset := atyp^.size
  645.                         ELSE x.offset := atyp^.n
  646.                         END;
  647.                         IF ParReg THEN INC(y.reg) ELSE INC(y.offset, 4) END;
  648.                         OPC.Assign(y, x);
  649.                         IF ParReg THEN OPL.LockParR(y.reg) END;
  650.                         typ := typ^.BaseTyp; atyp := atyp^.BaseTyp; DEC(n)
  651.                     END
  652.                 ELSE
  653.                     dest := rt; z := y; (* dest of adr part *)
  654.                     n := typ^.n; typ := typ^.BaseTyp; x.typ := OPT.linttyp;
  655.                     y.typ := OPT.linttyp; mode := desc.dmode; x.mode := SHORT(SHORT(mode)); x.reg := desc.dreg;
  656.                     WHILE n >= 0 DO
  657.                         IF ParReg THEN INC(y.reg); rt := y.reg ELSE INC(y.offset, 4); rt := -1 END;
  658.                         IF typ^.form = Byte THEN
  659.                             x := desc; OPC.TypeSize(x, atyp, rt); ASSERT(n = 0);
  660.                             IF x.dreg # -1 THEN OPL.FreeTempR(x.dreg); x.dreg := -1 END
  661.                         ELSIF mode = Reg THEN x.reg := desc.dreg+atyp^.offset DIV 4
  662.                         ELSE x.mode := SHORT(SHORT(mode)); x.reg := desc.dreg; x.offset := desc.adr+atyp^.offset
  663.                         END;
  664.                         OPC.Assign(y, x);
  665.                         IF ParReg THEN OPL.LockParR(rt) END;
  666.                         typ := typ^.BaseTyp; atyp := atyp^.BaseTyp; DEC(n)
  667.                     END;
  668.                     OPC.LoadAddr(tag, dest); z.typ := OPT.linttyp; OPC.Assign(z, tag)
  669.                 END
  670.             END;
  671.             IF desc.dreg # -1 THEN OPL.UnholdTempR(desc.dreg); OPL.FreeTempR(desc.dreg) END; 
  672.             formal := formal^.link; actual := actual^.link
  673.         END
  674.     END ActualPar;
  675.     PROCEDURE ArgSize (par: OPT.Object): LONGINT;
  676.         VAR s: LONGINT; c: SHORTINT; typ: OPT.Struct;
  677.     BEGIN s := 0;
  678.         WHILE par # NIL DO
  679.             typ := par^.typ; c := typ^.comp;
  680.             IF c = DynArr THEN INC(s, typ^.size)
  681.             ELSIF par^.mode = VarPar THEN
  682.                 IF c = Record THEN INC(s, 8) ELSE INC(s, 4) END
  683.             ELSE
  684.                 IF c IN {Record, Array} THEN INC(s, 4)
  685.                 ELSIF typ^.form = LReal THEN INC(s, 8 + s MOD 8)
  686.                 ELSIF typ^.form = ProcTyp THEN INC(s, 8)
  687.                 ELSE INC(s, 4)
  688.                 END
  689.             END;
  690.             par := par^.link
  691.         END;
  692.         Align(s, 8); RETURN s*10000H
  693.     END ArgSize;
  694.     PROCEDURE Call (n: OPT.Node; VAR res: OPL.Item; rt: LONGINT);
  695.         VAR
  696.             x: OPL.Item;
  697.             parSize, t: LONGINT;
  698.             function: BOOLEAN;
  699.             saved: OPL.SaveDesc;
  700.             proc: OPT.Object;
  701.     BEGIN
  702.         INC(levCall); t := -1;
  703.         (* IF n^.left^.class IN {Nfield, Nderef, Nindex} THEN OPL.LockParR(12); t := 12 END; *)
  704.         (* design(n^.left, x, t); *) function := n^.typ^.form # NoTyp;    (* << evaluation of designator delayed, 5.1.93 *)
  705.         IF function THEN OPC.SaveRegisters(x, saved) END;
  706.         ActualPar(n^.obj, n^.right);
  707.         design(n^.left, x, -1);
  708.         IF ~(x.mode IN {CProc, IProc}) THEN
  709.             IF x.mode IN {LProc, XProc} THEN
  710.                 proc := n^.left^.obj; parSize := proc^.conval^.intval;
  711.                 IF parSize = -1 THEN parSize := ArgSize(proc^.link); proc^.conval^.intval := parSize END
  712.             ELSE parSize := ArgSize((*n^.left^.typ^.link*)n^.obj)
  713.             END;
  714.             IF x.mode = TProc THEN OPC.GetMethod(x, n^.right^.typ, n^.obj^.typ^.form = Pointer, x.dmode = 1) END;
  715.             OPC.Call(x, parSize DIV 10000H);
  716.             IF x.mode IN {LProc, XProc} THEN n^.left^.obj^.adr := x.offset; n^.left^.obj^.linkadr := x.adr END
  717.         ELSE OPM.err(299)
  718.         END;
  719.         IF function THEN
  720.             res.typ := n.typ; res.dreg := -1;
  721.             IF res.typ^.form IN {Real, LReal} THEN res.mode := FReg; res.reg := 1 ELSE res.mode := Reg; res.reg := 3 END;
  722.             OPC.RestoreRegisters(res, saved, rt)
  723.         END;
  724.         IF levCall = 1 THEN OPL.FreePar END;
  725.         DEC(levCall)
  726.     END Call;
  727.     PROCEDURE Dim (VAR x, nofel: OPL.Item; n: OPT.Node; typ: OPT.Struct; nofdim, rt: LONGINT);
  728.         VAR
  729.             len, y: OPL.Item;
  730.             btyp: OPT.Struct;
  731.     BEGIN rt := -1;
  732.         IF (nofdim = 1) & (typ^.BaseTyp^.form IN {Byte, Bool, Char, SInt}) THEN rt := 4 END;
  733.         expr(n, len, rt);
  734.         IF nofdim = 1 THEN OPL.LockParR(3) (*tag*); OPL.LockParR(4) (*nofelem*); OPL.LockParR(5) (*nofdim*) END;
  735.         IF len.mode # Con THEN OPC.Load(len, -1); OPL.HoldTempR(len.reg); OPC.GenDimTrap(len) END;
  736.         IF nofdim = 1 THEN nofel := len ELSE OPC.MulDim(nofel, len, 4) END;
  737.         IF n^.link # NIL THEN
  738.             Dim(x, nofel, n^.link, typ^.BaseTyp, nofdim+1, rt)
  739.         ELSE
  740.             btyp := typ^.BaseTyp; rt := 1;
  741.             WHILE btyp^.comp = Array DO
  742.                 rt := rt*btyp^.n; btyp := btyp^.BaseTyp
  743.             END;
  744.             IF rt # 1 THEN
  745.                 y.mode := Con; y.offset := rt; y.typ := OPT.linttyp; OPC.MulDim(nofel, y, 4)
  746.             END;
  747.             OPC.NewArr(x, nofel, nofdim, btyp, rt); OPL.HoldTempR(x.reg);
  748.         END;
  749.         ASSERT(x.mode = Reg);
  750.         y := x; y.mode := Based; y.offset := 8;
  751.         OPC.SetDim(y, len, typ);
  752.         IF nofdim = 1 THEN OPL.UnholdTempR(x.reg) END;
  753.     END Dim;
  754.     PROCEDURE stat (n: OPT.Node);
  755.         VAR
  756.             x, y, z: OPL.Item;
  757.             rt, subcl: LONGINT;
  758.             l: OPL.Label;
  759.             var, adr: OPT.Node;
  760.             s: ARRAY 64 OF CHAR;
  761.             tmpStats : Stats; (* debugger info *)
  762.     BEGIN
  763.         WHILE n # NIL DO OPM.errpos := n^.conval^.intval; (* OPL.BegStat *)
  764.             x.Tjmp := 0; x.Fjmp := 0; y.Tjmp := 0; y.Fjmp := 0; z.Tjmp := 0; z.Fjmp := 0;
  765.             IF findpc THEN                (* debugger infos *)
  766.                 IF (lastClass # Nifelse) & (n^.class # Nwhile) & (n^.class # Nrepeat)  THEN
  767.                     IF stats = NIL THEN NEW (stats); curStats := stats END;
  768.                     IF curStats.numStat = 128 THEN tmpStats := curStats; NEW (curStats); tmpStats.next := curStats END;
  769.                     IF n^.class # Nenter THEN 
  770.                         curStats.pc[curStats.numStat] := SHORT (SHORT (OPL.pc - decPC)); decPC := OPL.pc;
  771.                         curStats.pos[curStats.numStat] := lastErr;
  772.                         INC (curStats.numStat)
  773.                     END
  774.                 END; 
  775.                 lastClass := n^.class;
  776.                 lastErr := OPM.errpos
  777.             END;
  778.             CASE n^.class OF
  779.                 Nenter:
  780.                     Enter(n); stat(n^.left); OPC.Enter(n^.obj); stat(n^.right);
  781.                     IF findpc THEN
  782.                         IF curStats.numStat = 128 THEN tmpStats := curStats; NEW (curStats); tmpStats.next := curStats END;
  783.                         curStats.pc[curStats.numStat] := SHORT (SHORT (OPL.pc - decPC)); decPC := OPL.pc;
  784.                         curStats.pos[curStats.numStat] := lastErr;
  785.                         INC (curStats.numStat)
  786.                     END;
  787.                     OPC.Leave(n^.obj);
  788.                     IF n^.obj # NIL THEN
  789.                         DEC(OPL.level);
  790.                         IF n^.obj^.mode = TProc THEN
  791.                             rt := 0; subcl := 0;
  792.                             COPY(n^.obj^.link^.typ^.strobj^.name, s);
  793.                             WHILE s[rt] # 0X DO INC(rt) END;
  794.                             s[rt] := "."; INC(rt);
  795.                             REPEAT s[rt] := n^.obj^.name[subcl]; INC(rt); INC(subcl) UNTIL s[rt-1] = 0X;
  796.                             OPL.OutRefName(s)
  797.                         ELSE
  798.                             OPL.OutRefName(n^.obj^.name)
  799.                         END;
  800.                         OPL.OutRefs(n^.obj^.scope^.right)
  801.                     ELSE
  802.                         OPL.OutRefName("$$"); OPL.OutRefs(OPT.topScope)
  803.                     END;
  804.             |  Ninittd:
  805.                     (* done at load time *)
  806.             |  Nassign:
  807.                     subcl := n^.subcl;
  808.                     IF subcl = movefn THEN
  809.                         expr(n^.right^.link, z, -1); expr(n^.right, y, -1); expr(n^.left, x, -1);
  810.                         OPC.SYSmove(x, y, z)
  811.                     ELSIF subcl = newfn THEN
  812.                         IF n^.right # NIL THEN (* open array *)
  813.                             Dim(y, (*nofel*)z, n^.right, n^.left^.typ^.BaseTyp, 1, -1)
  814.                         ELSE
  815.                             OPC.NewRec(y, n^.left^.typ^.BaseTyp, -1)
  816.                         END;
  817.                         design(n^.left, x, -1); OPC.Assign(x, y)
  818.                     ELSE
  819.                         IF subcl IN {getfn, putfn} THEN
  820.                             IF subcl = getfn THEN var := n^.left; adr := n^.right
  821.                             ELSE var := n^.right; adr := n^.left
  822.                             END;
  823.                             z.mode := Con; z.typ := OPT.linttyp; z.offset := 0;
  824.                             IF adr^.class = Ndop THEN
  825.                                 IF adr^.subcl = plus THEN expr(adr^.left, x, -1); expr(adr^.right, z, -1)
  826.                                 ELSIF (adr^.subcl = minus) & (adr^.right^.class = Nconst) THEN
  827.                                     expr(adr^.left, x, -1); expr(adr^.right, z, -1); z.offset := -z.offset
  828.                                 ELSE expr(adr, x, -1)
  829.                                 END
  830.                             ELSE
  831.                                 expr(adr, x, -1)
  832.                             END;
  833.                             expr(var, y, -1)
  834.                         ELSE
  835.                             expr(n^.left, x, -1);
  836.                             IF DoCommonDesign & (subcl = assign) & (n^.right^.class IN {Nmop, Ndop}) &
  837.                                 SameDesign(n^.left, n^.right^.left) THEN
  838.                                 OPC.CommonDesign(x); CommonDesign := x;
  839.                                 CommonDesignClass := n^.right^.left^.class;
  840.                                 n^.right^.left^.class := Ncommon
  841.                             END
  842.                         END;
  843.                         IF subcl = sysnewfn THEN rt := 3
  844.                         ELSIF (x.mode IN {Reg, FReg}) & (subcl = assign) &
  845.                             ((x.mode = FReg) = (n^.right^.typ^.form IN RealTypes)) THEN rt := x.reg
  846.                         ELSE rt := -1
  847.                         END;
  848.                         y.Tjmp := 0; y.Fjmp := 0;
  849.                         IF ~(subcl IN {newfn, getfn, putfn}) THEN expr(n^.right, y, rt);
  850.                             IF (n^.right^.left # NIL) & (n^.right^.left^.class = Ncommon) THEN
  851.                                 OPC.UnholdCommonDesign(CommonDesign); n^.left^.class := CommonDesignClass
  852.                             END
  853.                         END;
  854.                         CASE subcl OF
  855.                             assign:    
  856.                                 OPC.Assign(x, y)
  857.                         |  incfn, decfn:
  858.                                 OPC.Increment(x, y, subcl = incfn)
  859.                         |  inclfn:
  860.                                 OPC.Include(x, y)
  861.                         |  exclfn:
  862.                                 OPC.Exclude(x, y)
  863.                         |  getfn:
  864.                                 OPC.SYSget(x, z, y)
  865.                         |  putfn:
  866.                                 OPC.SYSput(x, z, y)
  867.                         |  getrfn:
  868.                                 OPC.SYSgetreg(x, y)
  869.                         |  putrfn:
  870.                                 OPC.SYSputreg(x, y)
  871.                         |  newfn:
  872.                         |  sysnewfn:
  873.                                 IF x.mode = Reg THEN rt := x.reg ELSE rt := -1 END;
  874.                                 OPC.NewSys(z, y, rt); OPC.Assign(x, z)
  875.                         |  copyfn:
  876.                                 OPC.Copy(x, y)
  877.                         END
  878.                     END
  879.             |  Nwhile:
  880.                     l := 0; OPC.SetLabel(l); x.Tjmp := 0; x.Fjmp := 0; expr(n^.left, x, -1); OPC.PutCondBranch(x, FALSE);
  881.                     OPC.SetLabel(x.Tjmp); Checkpc;
  882.                     stat(n^.right); OPC.PutBranch(l); OPC.SetLabel(x.Fjmp)
  883.             |  Nrepeat:
  884.                     x.Fjmp := 0; OPC.SetLabel(x.Fjmp); stat(n^.left); x.Tjmp := 0; expr(n^.right, x, -1);
  885.                     OPC.PutCondBranch(x, FALSE); OPC.SetLabel(x.Tjmp)
  886.             |  Nloop:
  887.                     OPC.EnterLoop; stat(n^.left); OPC.EndLoop
  888.             |  Nexit:
  889.                     OPC.ExitLoop
  890.             |  Ncall:
  891.                     Call(n, x, -1)
  892.             |  Nifelse:
  893.                     IF (n^.subcl # assertfn) OR assert THEN IfStat(n, FALSE) END
  894.             |  Ncase:
  895.                     CaseStat(n)
  896.             |  Nwith:
  897.                     IfStat(n, n^.subcl = 0)
  898.             |  Nreturn:
  899.                     IF n^.left # NIL THEN
  900.                         IF n^.obj^.typ^.form IN {Real, LReal} THEN rt := 1; x.mode := FReg ELSE rt := 3; x.mode := Reg END;
  901.                         y.Tjmp := 0; y.Fjmp := 0; y.dreg := -1;
  902.                         expr(n^.left, y, rt); x.typ := n^.obj^.typ; x.reg := rt; OPC.Assign(x, y)
  903.                     ELSE x.mode := Head
  904.                     END;
  905.                     OPC.Return(x)
  906.             |  Ntrap:
  907.                     OPC.Trap(SHORT(n^.right^.conval^.intval))
  908.             END;
  909.             Checkpc; OPL.EndStat; n := n^.link
  910.         END
  911.     END stat;
  912.     PROCEDURE Module* (prog: OPT.Node);
  913.     BEGIN levCall := 0; stat(prog);
  914.         IF findpc & OPM.noerr THEN OPM.err(254) END
  915.     END Module;
  916.     PROCEDURE Init* (opt: SET; bpc: LONGINT);
  917.         CONST ass = 8; fpc = 9; ppc = 10;
  918.     BEGIN
  919.         decPC := 0; stats := NIL; lastErr := OPM.errpos; lastClass := Ncall; (* debug info *)
  920.         assert := ass IN opt; findpc := fpc IN opt; powerpc := ppc IN opt;
  921.         IF findpc THEN OPM.breakpc := bpc ELSE OPM.breakpc := MAX(LONGINT) END
  922.     END Init;
  923. END POPV.
  924.             IF findpc THEN                (* debugger infos *)
  925.                 IF (n^.class#Nwhile) & (n^.class#Nrepeat) & (n^.class#Nifelse) & (n^.class#Ncase) THEN
  926.                     IF stats = NIL THEN NEW (stats); curStats := stats END;
  927.                     IF curStats.numStat = 128 THEN tmpStats := curStats; NEW (curStats); tmpStats.next := curStats END;
  928.                     IF n^.class # Nenter THEN 
  929.                         curStats.pc[curStats.numStat] := SHORT (SHORT (OPL.pc - decPC)); decPC := OPL.pc;
  930.                         curStats.pos[curStats.numStat] := OPM.errpos;
  931.                         INC (curStats.numStat)
  932.                     END;
  933.                 END
  934.             END;
  935.